home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.0 / stk-3 / blt-for-STk-3.0 / blt-1.9 / src / bltDebug.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-01  |  3.0 KB  |  106 lines
  1.  
  2. /*
  3.  * bltDebug.c --
  4.  *
  5.  * Copyright 1993-1994 by AT&T Bell Laboratories.
  6.  * Permission to use, copy, modify, and distribute this software
  7.  * and its documentation for any purpose and without fee is hereby
  8.  * granted, provided that the above copyright notice appear in all
  9.  * copies and that both that the copyright notice and warranty
  10.  * disclaimer appear in supporting documentation, and that the
  11.  * names of AT&T Bell Laboratories any of their entities not be used
  12.  * in advertising or publicity pertaining to distribution of the
  13.  * software without specific, written prior permission.
  14.  *
  15.  * AT&T disclaims all warranties with regard to this software, including
  16.  * all implied warranties of merchantability and fitness.  In no event
  17.  * shall AT&T be liable for any special, indirect or consequential
  18.  * damages or any damages whatsoever resulting from loss of use, data
  19.  * or profits, whether in an action of contract, negligence or other
  20.  * tortuous action, arising out of or in connection with the use or
  21.  * performance of this software.
  22.  *
  23.  */
  24.  
  25. #include "blt.h"
  26.  
  27. #ifndef DEBUG_VERSION
  28. #define DEBUG_VERSION "0.9"
  29. #endif
  30.  
  31. /*ARGSUSED*/
  32. static void
  33. DebugProc(clientData, interp, level, command, cmdProc, cmdClientData,
  34.     argc, argv)
  35.     ClientData clientData;    /* not used */
  36.     Tcl_Interp *interp;        /* not used */
  37.     int level;            /* Current level */
  38.     char *command;        /* Command before substitution */
  39.     int (*cmdProc) ();        /* not used */
  40.     ClientData cmdClientData;    /* not used */
  41.     int argc;
  42.     char **argv;        /* Command after parsing, but before
  43.                  * evaluation */
  44. {
  45.     register int i;
  46.  
  47.     fprintf(stderr, "%d>\t%s\n\t", level, command);
  48.     for (i = 0; i < argc; i++) {
  49.     fprintf(stderr, "%s ", argv[i]);
  50.     }
  51.     fputs("\n", stderr);
  52. }
  53.  
  54. /*ARGSUSED*/
  55. static int
  56. DebugCmd(clientData, interp, argc, argv)
  57.     ClientData clientData;    /* not used */
  58.     Tcl_Interp *interp;
  59.     int argc;
  60.     char **argv;
  61. {
  62.     static Tcl_Trace token;
  63.     static int level;
  64.     int newLevel;
  65.  
  66.     if (argc > 2) {
  67.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  68.         " ?level?\"", (char *)NULL);
  69.     return TCL_ERROR;
  70.     }
  71.     if (argc == 1) {
  72.     sprintf(interp->result, "%d", level);
  73.     return TCL_OK;
  74.     }
  75.     if (Tcl_GetInt(interp, argv[1], &newLevel) != TCL_OK) {
  76.     return TCL_ERROR;
  77.     }
  78.     if (newLevel < 0) {
  79.     newLevel = 0;
  80.     }
  81.     if ((newLevel == 0) && (level > 0)) {
  82.     Tcl_DeleteTrace(interp, token);
  83.     }
  84.     if ((newLevel > 0) && (level == 0)) {
  85.     token = Tcl_CreateTrace(interp, newLevel, DebugProc, (ClientData)0);
  86.     }
  87.     level = newLevel;
  88.     return TCL_OK;
  89. }
  90.  
  91. int
  92. Blt_DebugInit(interp)
  93.     Tcl_Interp *interp;
  94. {
  95.     if (Blt_FindCmd(interp, "blt_debug", (ClientData *)NULL) == TCL_OK) {
  96.     Tcl_AppendResult(interp, "\"blt_debug\" command already exists",
  97.         (char *)NULL);
  98.     return TCL_ERROR;
  99.     }
  100.     Tcl_SetVar2(interp, "blt_versions", "blt_debug", DEBUG_VERSION,
  101.     TCL_GLOBAL_ONLY);
  102.     Tcl_CreateCommand(interp, "blt_debug", DebugCmd, (ClientData)0,
  103.     (Tcl_CmdDeleteProc *)NULL);
  104.     return TCL_OK;
  105. }
  106.